home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / clx.lha / clx / excldefsys.l < prev    next >
Encoding:
Text File  |  1988-09-12  |  8.4 KB  |  271 lines
  1. ;;; -*- Mode: common-lisp; Package: user; Base: 10; Lowercase: Yes -*-
  2. ;;;
  3. ;;;             TEXAS INSTRUMENTS INCORPORATED
  4. ;;;                  P.O. BOX 2909
  5. ;;;                   AUSTIN, TEXAS 78769
  6. ;;;
  7. ;;; Copyright (C) 1987 Texas Instruments Incorporated.
  8. ;;;
  9. ;;; Permission is granted to any individual or institution to use, copy, modify,
  10. ;;; and distribute this software, provided that this complete copyright and
  11. ;;; permission notice is maintained, intact, in all copies and supporting
  12. ;;; documentation.
  13. ;;;
  14. ;;; Texas Instruments Incorporated provides this software "as is" without
  15. ;;; express or implied warranty.
  16. ;;;
  17.  
  18. ;;; NOTE: This is beta code.  There are various known problems (e.g.,
  19. ;;; various cases of gcontext shadowing, bullet-proof abort handling),
  20. ;;; and various features (e.g., less restrictive locking) being thought
  21. ;;; about.  Bug reports should be addressed to
  22. ;;; bug-clx@zermatt.lcs.mit.edu.
  23.  
  24. ;; Note: File mode-lines don't have:
  25. ;;    PACKAGE: (XLIB :USE (CL))
  26. ;;  because the TI Explorer doesn't fully support it.
  27. ;;  Define the XLIB package here instead.
  28.  
  29. #+ignore
  30. (eval-when (compile) (proclaim '(optimize (speed 1) (safety 3))))
  31.  
  32. ;;;
  33. ;;; NOTE: Enable the following if you will be using CLX and getting a SIGIO
  34. ;;;       signal when there is input on the X socket.  Remember to recompile
  35. ;;;       when you switch the setting.
  36.  
  37. #+delete_me_if_you_want_sigio_blocked
  38. (eval-when (load compile)
  39.   (setq *features* (union *features* '(:clx-blocksigio))))
  40.  
  41.  
  42. (in-package :user)
  43.  
  44. (require :foreign)
  45. (require :mdproc)
  46. (require :process)
  47.  
  48. (eval-when (load)
  49.   (require :clxexcldep "excldep")
  50.   (provide :clx))
  51.  
  52.  
  53. ;;
  54. ;; The following is a suggestion.  If you turn this off be prepared for
  55. ;; possible deadlock, since no interrupts will be recognized while
  56. ;; reading from the X socket.
  57. ;;
  58. (setq compiler::generate-interrupt-checks-switch
  59.   (compile nil '(lambda (safety size speed)
  60.          (declare (ignore safety size speed)) t)))
  61.  
  62.  
  63. ;;
  64. ;; Now the stuff that really belongs here
  65. ;;
  66. (in-package 'xlib :use '(foreign-functions lisp))
  67.  
  68. #+allegro
  69. (excl:defsystem clx
  70. ;;              (:default-pathname "/usr/src/local/X11/lib/CLX/")
  71.                 ()
  72.   (|depdefs|)
  73.   (|clx| :load-before-compile |depdefs|
  74.      :funcall-after sys:gsgc-step-generation
  75.      :recompile-on (|depdefs|))
  76.   (|dependent| :load-before-compile |clx|
  77.            :funcall-after sys:gsgc-step-generation
  78.            :recompile-on (|clx|))
  79.   (|macros| :load-before-compile |dependent|
  80.         :funcall-after sys:gsgc-step-generation
  81.         :compile-satisfies-load t
  82.         :recompile-on (|dependent|))
  83.   (|bufmac| :load-before-compile |macros|
  84.         :funcall-after sys:gsgc-step-generation
  85.         :compile-satisfies-load t
  86.         :recompile-on (|macros|))
  87.   (|buffer| :load-before-compile |bufmac|
  88.         :funcall-after sys:gsgc-step-generation
  89.         :recompile-on (|bufmac|))
  90.   (|display| :load-before-compile |buffer|
  91.          :funcall-after sys:gsgc-step-generation
  92.          :recompile-on (|buffer|))
  93.   (|gcontext| :load-before-compile |display|
  94.           :funcall-after sys:gsgc-step-generation
  95.           :recompile-on (|display|))
  96.   (|requests| :load-before-compile |display|
  97.           :funcall-after sys:gsgc-step-generation
  98.           :recompile-on (|display|))
  99.   (|input| :load-before-compile |display|
  100.        :funcall-after sys:gsgc-step-generation
  101.        :recompile-on (|display|))
  102.   (|fonts| :load-before-compile |display|
  103.        :funcall-after sys:gsgc-step-generation
  104.        :recompile-on (|display|))
  105.   (|graphics| :load-before-compile |fonts|
  106.           :funcall-after sys:gsgc-step-generation
  107.           :recompile-on (|fonts|))
  108.   (|text| :load-before-compile (|gcontext| |fonts|)
  109.       :funcall-after sys:gsgc-step-generation
  110.       :recompile-on (|gcontext| |fonts|)
  111.       :load-after (|translate|))
  112.   ;; This above line gets around a compiler macro expansion bug.
  113.   (|attributes| :load-before-compile |display|
  114.         :funcall-after sys:gsgc-step-generation
  115.         :recompile-on (|display|))
  116.   (|translate| :load-before-compile |text|
  117.          :funcall-after sys:gsgc-step-generation
  118.          :recompile-on (|display|))
  119.   (|keysyms| :load-before-compile |translate|
  120.          :funcall-after sys:gsgc-step-generation
  121.          :recompile-on (|translate|))
  122.   (|manager| :load-before-compile |display|
  123.          :funcall-after sys:gsgc-step-generation
  124.          :recompile-on (|display|))
  125.   (|image| :load-before-compile |display|
  126.        :funcall-after sys:gsgc-step-generation
  127.        :recompile-on (|display|))
  128.   (|resource|)
  129.   )
  130.  
  131.  
  132. #-lispm
  133. (defun compile-clx (&optional pathname-defaults)
  134.   (let ((*default-pathname-defaults*
  135.       (or pathname-defaults *default-pathname-defaults*)))
  136.     (declare (special *default-pathname-defaults*))
  137.     (compile-file "depdefs")
  138.     (load "depdefs")
  139.     (compile-file "clx")
  140.     (load "clx")
  141.     (compile-file "dependent")
  142.     (load "dependent")
  143.     (compile-file "macros")
  144.     (load "macros")
  145.     (compile-file "bufmac")
  146.     (load "bufmac")
  147.     (compile-file "buffer")
  148.     (load "buffer")
  149.     (compile-file "display")
  150.     (load "display")
  151.     (compile-file "gcontext")
  152.     (load "gcontext")
  153.     (compile-file "requests")
  154.     (load "requests")
  155.     (compile-file "input")
  156.     (load "input")
  157.     (compile-file "fonts")
  158.     (load "fonts")
  159.     (compile-file "graphics")
  160.     (load "graphics")
  161.     (compile-file "text")
  162.     (load "text")
  163.     (compile-file "attributes")
  164.     (load "attributes")
  165.     (load "translate")
  166.     (compile-file "translate")            ; work-around bug in 2.0 and 2.2
  167.     (load "translate")
  168.     (compile-file "keysyms")
  169.     (load "keysyms")
  170.     (compile-file "manager")
  171.     (load "manager")
  172.     (compile-file "image")
  173.     (load "image")
  174.     (compile-file "resource")
  175.     (load "resource")
  176.     ))
  177.  
  178. #-lispm
  179. (defun load-clx (&optional pathname-defaults (macros-p t))
  180.   (let ((*default-pathname-defaults*
  181.       (or pathname-defaults *default-pathname-defaults*)))
  182.     (declare (special *default-pathname-defaults*))
  183.     (load "depdefs")
  184.     (load "clx")
  185.     (load "dependent")
  186.     (when macros-p
  187.       (load "macros")
  188.       (load "bufmac"))
  189.     (load "buffer")
  190.     (load "display")
  191.     (load "gcontext")
  192.     (load "requests")
  193.     (load "input")
  194.     (load "fonts")
  195.     (load "graphics")
  196.     (load "text")
  197.     (load "attributes")
  198.     (load "translate")
  199.     (load "keysyms")
  200.     (load "manager")
  201.     (load "image")
  202.     (load "resource")
  203.     ))
  204.  
  205.  
  206. (ff:remove-entry-point (ff:convert-to-lang "connect_to_server" :language :c))
  207. (ff:remove-entry-point (ff:convert-to-lang "c_check_bytes" :language :c))
  208. (ff:remove-entry-point (ff:convert-to-lang "c_read_bytes" :language :c))
  209. (ff:remove-entry-point (ff:convert-to-lang "c_read_bytes_interruptible"
  210.                        :language :c))
  211. (ff:remove-entry-point (ff:convert-to-lang "c_write_bytes" :language :c))
  212. (ff:remove-entry-point (ff:convert-to-lang "c_flush_bytes" :language :c))
  213. (load "socket.o")
  214. (load "excldep.o")
  215.  
  216. (ff:defforeign-list `((xlib::connect-to-server
  217.                :entry-point
  218.                ,(ff:convert-to-lang "connect_to_server" :language :c)
  219.                :return-type :fixnum
  220.                :arg-checking nil
  221.                :arguments (string fixnum))
  222.               (xlib::c-check-bytes
  223.                :entry-point
  224.                ,(ff:convert-to-lang "c_check_bytes" :language :c)
  225.                :return-type :fixnum
  226.                :arg-checking nil
  227.                :arguments (fixnum fixnum))
  228.               (xlib::c-read-bytes
  229.                :entry-point
  230.                ,(ff:convert-to-lang "c_read_bytes" :language :c)
  231.                :return-type :fixnum
  232.                :arg-checking nil
  233.                :arguments (fixnum (simple-array (unsigned-byte 8))
  234.                    fixnum fixnum))
  235.               (xlib::c-read-bytes-interruptible
  236.                :entry-point
  237.                ,(ff:convert-to-lang "c_read_bytes_interruptible"
  238.              :language :c)
  239.                :return-type :fixnum
  240.                :arg-checking nil
  241.                :arguments (fixnum (simple-array (unsigned-byte 8))
  242.                    fixnum fixnum))
  243.               (xlib::c-write-bytes
  244.                :entry-point
  245.                ,(ff:convert-to-lang "c_write_bytes" :language :c)
  246.                :return-type :fixnum
  247.                :arg-checking nil
  248.                :arguments (fixnum (simple-array (unsigned-byte 8))
  249.                    fixnum fixnum))
  250.               (xlib::c-flush-bytes
  251.                :entry-point
  252.                ,(ff:convert-to-lang "c_flush_bytes" :language :c)
  253.                :return-type :fixnum
  254.                :arg-checking nil
  255.                :arguments (fixnum))
  256.               #+clx-blocksigio
  257.               (xlib::sigblock
  258.                :entry-point
  259.                ,(ff:convert-to-lang "sigblock" :language :c)
  260.                :return-type :integer
  261.                :arg-checking nil
  262.                :arguments (integer))
  263.               #+clx-blocksigio
  264.               (xlib::sigsetmask
  265.                :entry-point
  266.                ,(ff:convert-to-lang "sigsetmask" :language :c)
  267.                :return-type :integer
  268.                :arg-checking nil
  269.                :arguments (integer))
  270.               ))
  271.